In the past I have not written about stuff I implement, I thought it would be good to start now. For documenting stuff to myself later, and maybe it's usefully/interesting to someone else too.
This blog post is about r7rs-pffi and how to implement support for new feature for it. I will also try to lay out the structure of the project so that it can serve as a guide on how to add support for new Scheme implementation.
TL;DR give me the code already
If you would like to try this code the easiest way is to clone the example-libcurl, install Sagittarius and then run:
bash sagittarius.sh
on windows you would run:
sagittarius.bat
If you are reading this later and callback support is implemented for other Scheme implementations too then check out other .sh and .bat files in the repository.
It all starts from the main
If you look into the repository you can see directory retropikzel/pffi/VERSION which holds files called main.sld, main.scm, main.rkt and file for each implementation like sagittarius.scm, guile.scm and so on.
The real main file is main.sld, the reason so many main files exists is that some implementations do not support .sld files (Kawa), and some (Cyclone) does not support .scm files. And of course the .rkt file is for Racket. The Makefile builds the main.scm and main.rkt from main.sld.
All code is also inside the .sld, .scm and .rkt file because not all implementation (include...) the same way/from same path, so it's simpler to have everything in same file and then copy that file with different file endings.
The main.sld defines the library and then uses cond expand to import the implementation specific file that contains the implementation specific code. Cond-expand would allow us to keep all the code in one file but some Guile specific code (#:) errors on Sagittarius. I'm assuming the reader macros do not respect the cond-expand. Anyway, when the supported implementation list grows having one file per implementation is also quite neat way to organize the code.
Glimpse:
(define-library
(retropikzel pffi v0-2-2 main)
(cond-expand
(sagittarius
(import (scheme base)
(scheme write)
(scheme file)
(scheme process-context)
(retropikzel pffi v0-2-2 sagittarius)))
(guile
(import (scheme base)
(scheme write)
(scheme file)
(scheme process-context)
(retropikzel pffi v0-2-2 guile)))
(racket
(import (scheme base)
(scheme write)
(scheme file)
(scheme process-context)
(only (racket base) system-type)
(retropikzel pffi v0-2-2 racket)))
...
The main.sld exports the shared code, which it also holds, and procedures from implementaton specific libraries.
Glimpse:
(export pffi-shared-object-auto-load
pffi-shared-object-load
pffi-define
pffi-define-callback ; Our new functionality!
pffi-size-of
pffi-pointer-allocate
pffi-pointer-null
pffi-string->pointer
pffi-pointer->string
pffi-pointer-free
pffi-pointer?
pffi-pointer-null?
pffi-pointer-set!
pffi-pointer-get
pffi-pointer-deref)
...
Implementation specific code
I will use Sagittarius as example.
Implementation specific libraries define all the procedures that are not defined in main.sld. They are implementation specific and often require their own libraries and such.
From retropikzel/pffi/VERSION/sagittarius.scm:
(define-library
(retropikzel pffi v0-2-2 sagittarius)
(import (scheme base)
(scheme write)
(scheme file)
(scheme process-context)
(sagittarius ffi)
(sagittarius))
...
As you can see we import for example the (sagittarius ffi). Which holds the sagittarus foreign function interface.
Then we export the implementation specific procedures, from retropikzel/pffi/VERSION/sagittarius.scm:
(export pffi-shared-object-load
pffi-define
pffi-define-callback ; Our new functionality!
pffi-size-of
pffi-pointer-allocate
pffi-pointer-null
pffi-string->pointer
pffi-pointer->string
pffi-pointer-free
pffi-pointer?
pffi-pointer-null?
pffi-pointer-set!
pffi-pointer-get
pffi-pointer-deref)
...
which are exported from the main.sld too, but implemented for real in here.
Adding new feature or support for new implementation
Import the library in main
If we were adding support for new implementation from scracth we would need to add it into the cond-expand in main.sld that's right after the library name.
Sagittarius already has this:
(define-library
(retropikzel pffi v0-2-2 main)
(cond-expand
(sagittarius
(import (scheme base)
(scheme write)
(scheme file)
(scheme process-context)
(retropikzel pffi v0-2-2 sagittarius)))
(guile
(import (scheme base)
(scheme write)
(scheme file)
(scheme process-context)
(retropikzel pffi v0-2-2 guile)))
...
Add the implementation file
If we were adding support for new implementaton from scratch we would need to add file retropikzel/pffi/VERSION/IMPLEMENTATION.scm.
Sagittarius already has this, from retropikzel/pffi/VERSION/sagittarius.scm:
(define-library
(retropikzel pffi v0-2-2 sagittarius)
(import (scheme base)
(scheme write)
(scheme file)
(scheme process-context)
(sagittarius ffi)
(sagittarius))
...
Code the code
If we were adding support for new implementation from scratch I recommend you copy the code from previously implemented file, like retropikzel/pffi/VERSION/sagittarius.scm. And then change only whats needed.
Now that we are adding new functionality we add the code for pffi-define-callback:
(define-syntax pffi-define-callback
(syntax-rules ()
((pffi-define-callback scheme-name return-type argument-types)
(define scheme-name
(make-c-callback (pffi-type->native-type return-type)
(map pffi-type->native-type argument-types))))))
What happens in the implementation specific code and is it a procedure or a macro is not that important. What is important is that the same code works same on all implementations, which gets us to our next part.
We also need to add new type called callback, this is Sagittarius specific so on many implementations it propably will map to just pointer. There are procedures to handle conversions which make these implementation specific things irrelevant to the library user. There is similarly "string" type which is residue from trying to add STKlos support, on most implementations it just maps to pointer.
From retropikzel/pffi/VERSION/sagittarius.scm:
(define pffi-type->native-type
(lambda (type)
(cond ((equal? type 'int8) 'int8_t)
((equal? type 'uint8) 'uint8_t)
((equal? type 'int16) 'int16_t)
((equal? type 'uint16) 'uint16_t)
((equal? type 'int32) 'int32_t)
((equal? type 'uint32) 'uint32_t)
((equal? type 'int64) 'int64_t)
((equal? type 'uint64) 'uint64_t)
((equal? type 'char) 'char)
((equal? type 'unsigned-char) 'char)
((equal? type 'short) 'short)
((equal? type 'unsigned-short) 'unsigned-short)
((equal? type 'int) 'int)
((equal? type 'unsigned-int) 'unsigned-int)
((equal? type 'long) 'long)
((equal? type 'unsigned-long) 'unsigned-long)
((equal? type 'float) 'float)
((equal? type 'double) 'double)
((equal? type 'pointer) 'void*)
((equal? type 'string) 'char*)
((equal? type 'void) 'void)
((equal? type 'callback) 'callback) ; New type we added just now!
(else (error "pffi-type->native-type -- No such pffi type" type)))))
Test the code
Test runners
The test runners are bash scripts on the root directory named test-IMPLEMENTATION.sh, there is also the test-all.sh which runs all the test-IMPLEMENTATION.sh scripts. If we were implementing support from scratch we would need to add this file.
Sagittarius already has test-sagittarius.sh which looks like this:
#!/usr/bin/env bash
source scripts/init-test.sh
SCHEME="sash -c -r7 -L ."
source scripts/test-runs-dynamic.sh
The actual test runner is the scripts/test-runs-dynamic.sh which uses the SCHEME environment variable to run tests, it looks like this:
for file in ./test/*.scm
do
echo "==========================================================="
echo "Testing ${file}, with ${SCHEME}"
echo "==========================================================="
${SCHEME} ${file}
done
Note that if the new implementation compiles scheme to for example C then you would need to use the scripts/test-runs-compiler.sh. Here is the test-chicken.sh:
#!/usr/bin/env bash
source scripts/init-test.sh
SCHEME="csc -X r7rs -R r7rs -L -lcurl"
SCHEME_LIB="csc -X r7rs -R r7rs -sJ"
SCHEME_I="csi -R r7rs"
cp retropikzel/pffi/${VERSION}/main.sld retropikzel/pffi/${VERSION}/retropikzel.pffi.${VERSION}.main.scm
cp retropikzel/pffi/${VERSION}/chicken.scm retropikzel/pffi/${VERSION}/retropikzel.pffi.${VERSION}.chicken.scm
cp retropikzel/pffi/${VERSION}/main.sld retropikzel.pffi.${VERSION}.main.scm
cp retropikzel/pffi/${VERSION}/chicken.scm retropikzel.pffi.${VERSION}.chicken.scm
${SCHEME_LIB} retropikzel.pffi.${VERSION}.chicken.scm
${SCHEME_LIB} retropikzel.pffi.${VERSION}.main.scm
source scripts/test-runs-compilers.sh
This is currently very chicken specific, as it's the only supported implementation for now that compiles to C.
Tests themselves
The tests are under directory named "test". For example the to just import the r7rs-pffi library is called 200_import.scm. The filenames start with number so they are executed in right order.
For this functionality we are implementing, which is callback support, we will make a test that uses libcurl. Since that is what we want to support then it makes sense to make the test a "real deal".
I have not used libcurl with C before. So here are the resources I used to make the test:
- libcurl tutorial.
- CURLOPT_WRITEFUNCTION explained
- Stakcoverflow - C libcurl get output into a string
- libcurl error codes
test/800_libcurl.scm:
(import (scheme base)
(scheme write)
(scheme process-context)
(retropikzel pffi v0-2-2 main)
(sagittarius ffi))
(define libcurl (pffi-shared-object-auto-load (list "curl/curl.h") ; Headers
(list ".") ; Additional search paths
"curl" ; The named of shared object without the lib prefix
(list ".4"))) ;Additional versions to search
(pffi-define curl-easy-init libcurl 'curl_easy_init 'pointer (list))
; Define the curl-easy-setopt twice since some implementations (Sagittarius) complain if you pass
; callback type instead of pointer type
(pffi-define curl-easy-setopt libcurl 'curl_easy_setopt 'int (list 'pointer 'int 'pointer))
(pffi-define curl-easy-setopt-callback libcurl 'curl_easy_setopt 'int (list 'pointer 'int 'callback))
(pffi-define curl-easy-perform libcurl 'curl_easy_perform 'int (list 'pointer))
;These values need to be get from c file like this:
; #include <curl/curl.h>
; int main() {
; printf("Value: %d", CURLOPT_WRITEFUNCTION);
; }
; many times you can get them from .h files directly
(define CURLOPT-WRITEFUNCTION 20011)
(define CURLOPT-FOLLOWLOCATION 52)
(define CURLOPT-URL 10002)
(define result "")
(pffi-define-callback collect-result
'void
(list 'pointer 'int 'int 'pointer)
(lambda (pointer size nmemb client-pointer)
(set! result
(string-append result (pffi-pointer->string pointer)))))
(define handle (curl-easy-init))
(define url (pffi-string->pointer "https://scheme.org"))
(define curl-code1 (curl-easy-setopt handle CURLOPT-FOLLOWLOCATION url))
(define curl-code2 (curl-easy-setopt handle CURLOPT-URL url))
(define curl-code3 (curl-easy-setopt-callback handle CURLOPT-WRITEFUNCTION collect-result))
(display curl-code1)
(newline)
(display curl-code2)
(newline)
(display curl-code3)
(newline)
(curl-easy-perform handle)
(display (string-length result))
(newline)
the code is also in r7rs-pffi/example-libcurl.
Now when the run
bash test-sagittarius.sh
We get (after all other tests):
===========================================================
Testing ./test/800_libcurl.scm, with sash -c -r7 -L .
===========================================================
0
0
0
9499
The three zeros tell us that there were no errors and the 9499 is the length of the response. If you want to see the response add
(display response)
(newline)
to the end of the code. I'm using the lenght because it works better for tests and blog posts.
Last but not least, document the library
Since we are adding new functionality we need to add documentation for it in the README.md.
#### pffi-define-callback
Defines new callback function.
Arguments:
- scheme-name
- The name of the function used on scheme side
- return-type - symbol
- The return type of the callback
- arguments-types - (list symbol ...)
- The callback function argument types
- procedure - procedure
- Procedure used as callback function
- Argument count must mathc the argument-types count
Conclusion
I'm glad I started blogging. That's the reason I looked into the callback support in the first place, as I wanted to make a simple example for r7rs-pffi and chose libcurl. That made me aware that libcurl uses callbacks and that leaving out support for them would make the library much less usefull. And then when I looked into how to implement callbacks it turned out that many implementations have support. Which I assumed previously they did not.
Of course this is support just for Sagittarius, now the work has to be done to all the other implementations too. You can track the progress here.
I wont propably be writing about them as it's pretty much the same story. Except maybe for Kawa as there I have implemented the FFI using the JEP 454: Foreign Function & Memory API.